(DECLARE (*LSUBR ZERROR FAIL FINALIZE NETDIF RESTORE VAL ZVAL)
	 (SPECIAL ZALIST ZSUCCEED? ZDEMON ZACCUM ZTHRSH ZSAVEP ZSAVED ZSAVEF
		  ZSAVF1 ZPAT ZDATS ZLIST ZLIST1 ZPROCS ZRNG ZRSETV ZVLD)
	 (SPECIAL Z*NIL* FAIL DONE ZHIGH ZLOW ZRANGE ZNET DPROCS APROCS EPROCS
		  ZSAVE ZGLOBEV ZTEMPV ZFETCHV ZRESETV ZINSTF ZINSTPF ZINST?F
		  ZLOOKV %%ENDGP FUZZYMACS ZVALUE ZTEMP2 MODCHR! MODCHR& MODCHR?
		  ZALIST1 ZVALD ZDEDUCEV ZGENPROCN ZGENPROCS LASTWORD ZTRACEDFNS
		  *ARG #%INDENT FUZZYMESS)
	 (SPECIAL %%TIME %%GCTIME %%SPEAK ALLFNS BASE *NOPOINT ZINDEX ZNAME
		  DEFDEMON DEFZVAL DEFACCUM))

(DEFPROP ACCUM:
 (LAMBDA (Z-NM) (ZPROCN (CAR Z-NM) 'ACCUM: (FUNCTION CDDDDR) (CDR Z-NM)))
 FEXPR)

(DEFPROP ADD
 (LAMBDA (Z-DAT)
  (PROG (Z-L Z-Z)
	(SETQ Z-Z (CDR Z-DAT))
	(SETQ Z-DAT (CAR Z-DAT))
	(COND [(NOT (SETQ Z-L (ZPROC? Z-DAT)))
	       (RETURN (ZADD (ZINST Z-DAT)
			     (COND [Z-Z (EVAL (CAR Z-Z))] [T ZHIGH])))]
	      [(NOT (ATOM (SETQ Z-Z (CAR Z-Z)))) (SETQ Z-Z (EVAL Z-Z))])
   REDO (COND [(NOT (GET Z-Z 'PDEF))
	       (SETQ Z-Z (ZERROR Z-Z '" IS NOT A PROC"))
	       (GO REDO)]
	      [(MEMB Z-Z (CDR Z-L)) (RETURN Z-Z)])
	(ZPLACD (LAST Z-L) (LIST Z-Z))
	(AND ZTRACEDFNS [ZBREAK1 '(ADD NET) NIL Z-Z 0.])
	(RETURN Z-Z)))
 FEXPR)

(DEFPROP ZADD
 (LAMBDA (Z-DAT Z-Z)
  (PROG (Z-L)
	(SETQ Z-DAT (CONS Z-DAT Z-Z))
	(COND [(MEMBER Z-DAT (CDR ZNET)) (GO DONE)] [T (ZREMOVE (CAR Z-DAT))])
	(ZPLACD (SETQ Z-L (ZMEMBN Z-Z ZNET)) (CONS Z-DAT (CDR Z-L)))
	(MAPC (FUNCTION
	       (LAMBDA (Z-A)
		(COND [(NOT (SETQ Z-L (GET Z-A ZINDEX)))
		       (PUT Z-A (SETQ Z-L (LIST (CONS NIL 0.))) ZINDEX)])
		(ZPLACD (CAR Z-L) (ADD1 (CDAR Z-L)))
		(ZPLACD (SETQ Z-L (ZMEMBN Z-Z Z-L)) (CONS Z-DAT (CDR Z-L)))))
	      (ZATOMS (CAR Z-DAT)))
	(AND ZTRACEDFNS [ZBREAK1 '(ADD NET) NIL Z-DAT 0.])
   DONE (RETURN (ZCAR Z-DAT))))
 EXPR)

(DEFPROP ZADDPROP
 (LAMBDA (AT VAL PROP) (ZPUT AT (CONS VAL (ZGET AT PROP)) PROP))
 EXPR)

(DEFPROP ZAND (LAMBDA (Z-L) (ZANDOR Z-L ZHIGH T)) FEXPR)

(DEFPROP ZANDOR
 (LAMBDA (Z-L Z-MZ Z-AND)
  (PROG (Z-TH Z-E Z-Z)
	(COND [(EQ (CAR Z-L) 'THRESH:)
	       (SETQ Z-TH (EVAL (CADR Z-L)))
	       (SETQ Z-L (CDDR Z-L))]
	      [T (SETQ Z-TH ZLOW)])
   LOOP (COND [(OR [EQ (SETQ Z-E (EVAL (CAR Z-L))) FAIL]
		   [LESSP (SETQ Z-Z (ZVALZ Z-E)) Z-TH])
	       (RETURN FAIL)]
	      [Z-AND (COND [(LESSP Z-Z Z-MZ) (SETQ Z-MZ Z-Z)])]
	      [(GREATERP Z-Z Z-MZ) (SETQ Z-MZ Z-Z)])
	(COND [(SETQ Z-L (CDR Z-L)) (GO LOOP)]
	      [T (RETURN (ZCONS (ZVALV Z-E) Z-MZ))])))
 EXPR)

(DEFPROP ASSERT
 (LAMBDA (Z-DAT)
  (ZCALLEM ZSAVE 
	   APROCS 
	   (ZADD (ZINST (CAR Z-DAT))
		 (COND [(CDR Z-DAT) (EVAL (CADR Z-DAT))] [T ZHIGH]))))
 FEXPR)

(DEFPROP ZATOMS
 (LAMBDA (Z-PAT) (SETQ ZTEMPV NIL) (ZATOM1 Z-PAT) ZTEMPV)
 EXPR)

(DEFPROP ZATOM1
 (LAMBDA (Z-PAT)
  (PROG (Z-C)
	(COND [(ATOM Z-PAT)
	       (COND [(AND Z-PAT 
			   [LITATOM Z-PAT]
			   [NOT (GET Z-PAT 'NOHASH)]
			   [NOT (MEMB Z-PAT ZTEMPV)])
		      (SETQ ZTEMPV (CONS Z-PAT ZTEMPV))])]
	      [(OR [NOT (LITATOM (SETQ Z-C (CAR Z-PAT)))]
		   [NOT (GET Z-C 'ZPATF)])
	       (MAPC (FUNCTION ZATOM1) Z-PAT)]
	      [(MEMB Z-C '(*AND *CON)) (MAPC (FUNCTION ZATOM1) (CDR Z-PAT))]
	      [(MEMB Z-C '(*ANY *NOT *R)) (ZATOM1 (CADR Z-PAT))])))
 EXPR)

(DEFPROP BACK
 (LAMBDA (Z-L)
  (COND [(EQ (ZSETV Z-L) Z*NIL*) (SETQ ZVALUE FAIL)])
  (THROW NIL BACK))
 FEXPR)

(DEFPROP BIND (LAMBDA (Z-V) (ZSET (CAR Z-V) (EVAL (CADR Z-V)))) FEXPR)

(DEFPROP BIND!
 (LAMBDA (Z-V)
  (PROG (Z-VAL)
	(SETQ Z-VAL (EVAL (CADR Z-V)))
	(COND [(ATOM (CAR Z-V)) (SET (CAR Z-V) Z-VAL)]
	      [T (RPLACD (CDR (ZLOOK (CADAR Z-V))) Z-VAL)])
	(RETURN Z-VAL)))
 FEXPR)

(DEFPROP ZBIND
 (LAMBDA (Z-A Z-V) (ZPLACD (CDR (ZLOOK Z-A)) Z-V) Z-V)
 EXPR)

(DEFPROP BOUND
 (LAMBDA (Z-V) (COND [(ZLOOK? (CADAR Z-V)) T] [T FAIL]))
 FEXPR)

(DEFPROP ZCALL
 (LAMBDA (Z-NM Z-DAT)
  (PROG (ZSUCCEED?)
	(SETQ ZRESETV NIL)
	(COND [(EQ (ZCALLP Z-NM Z-DAT) Z*NIL*) (RETURN FAIL)]
	      [(AND [CONSP ZVALUE] [EQ (CAR ZVALUE) Z*NIL*])
	       (SETQ ZVALUE (ZCONS (ZINSTR (ZVALV Z-DAT)) (CDR ZVALUE)))])
	(AND ZTRACEDFNS [ZBREAK1 (CONS Z-NM '(PROCS)) '"Leave " ZVALUE -3.])
	(RETURN ZVALUE)))
 EXPR)

(DEFPROP ZCALLP
 (LAMBDA (ZNAME Z-DAT)
  (PROG (Z-D)
	(COND [(NOT (SETQ Z-D (GET ZNAME 'PDEF)))
	       (ZERROR ZNAME '" UNDEFINED PROC")])
	(SETQ ZALIST1 ZALIST)
	(SETQ ZTEMPV (ZGLOBE (CADR Z-D)))
	(RETURN (PROG (ZALIST)
		      (SETQ ZALIST ZTEMPV)
		      (COND [(NOT (ZMATCH (ZINSTP (CAR Z-D)) (ZVALV Z-DAT)))
			     (RETURN (SETQ ZVALUE Z*NIL*))])
		      (AND ZTRACEDFNS 
			   [ZBREAK1 (CONS ZNAME '(PROCS)) '"Enter " Z-DAT 3.])
		      (SETQ ZVALD Z-DAT)
		      (RETURN (APPLY (FUNCTION ZPROC) (CDDR Z-D)))))))
 EXPR)

(DEFPROP ZCALLD
 (LAMBDA (Z-E)
  (AND ZDEMON 
       Z-E 
       [ZPLACD (GET 'ZACCUM 'VALUE) (ZDEMON Z-E ZTHRSH ZACCUM)]))
 EXPR)

(DEFPROP ZCALLEM
 (LAMBDA (Z-SAVE Z-L Z-DAT)
  (PROG (ZSUCCEED?)
	(SETQ ZRESETV NIL)
   LOOP (COND [(NULL (SETQ Z-L (CDR Z-L))) (RETURN Z-DAT)]
	      [(EQ (ZCALLP (CAR Z-L) Z-DAT) Z*NIL*) (GO LOOP)])
	(AND ZTRACEDFNS 
	     [ZBREAK1 (CONS (CAR Z-L) '(PROCS))
		      '"Leave "
		      (COND [(EQ (CAR ZVALUE) Z*NIL*) Z-DAT] [T ZVALUE])
		      -3.])
	(COND [(EQ ZVALUE FAIL) (ZRESTORE Z-SAVE) (RETURN FAIL)]
	      [T (GO LOOP)])))
 EXPR)

(DEFPROP ZCAR
 (LAMBDA (Z-E)
  (COND [(ATOM Z-E) Z-E] [(EQUAL (CDR Z-E) ZHIGH) (CAR Z-E)] [T Z-E]))
 EXPR)

(DEFPROP ZCONS
 (LAMBDA (Z-E Z-Z) (COND [(EQUAL Z-Z ZHIGH) Z-E] [T (CONS Z-E Z-Z)]))
 EXPR)

(DEFPROP CONTEXT
 (LAMBDA (Z-C)
  (AND [NULL Z-C] [SETQ Z-C 'INITIAL-CONTEXT])
  (COND [(NEQ Z-C ZINDEX)
	 (PUT ZINDEX ZNET 'CONTEXT)
	 (ZSET 'ZNET (OR [GET Z-C 'CONTEXT] [PUT Z-C (LIST NIL) 'CONTEXT]))])
  (PROG1 (COND [(EQ ZINDEX 'INITIAL-CONTEXT) NIL] [T ZINDEX])
	 (ZSET 'ZINDEX Z-C)))
 EXPR)

(DEFPROP DEDUCE
 (LAMBDA (Z-PAT)
  (SETQ ZRESETV NIL)
  (ZDEDUCE (ZINSTPD (CAR Z-PAT)) DPROCS (ZRANGER (ZRANGES (CDR Z-PAT)))))
 FEXPR)

(DEFPROP ZDEDUCE
 (LAMBDA (Z-PAT Z-L Z-R)
  (PROG (ZSUCCEED? ZSAVED)
	(SETQ ZSUCCEED? T)
	(COND [ZRESETV (GO RETRY)] [T (SETQ ZSAVED ZSAVE)])
   LOOP (COND [(NULL (SETQ Z-L (CDR Z-L))) (RETURN (SETQ ZVALUE FAIL))]
	      [(EQ (ZCALLP (CAR Z-L) Z-PAT) Z*NIL*) (GO LOOP)])
    TRY (AND [CONSP ZVALUE]
	     [EQ (CAR ZVALUE) Z*NIL*]
	     [SETQ ZVALUE (ZCONS (ZINSTR (ZVALV Z-PAT)) (CDR ZVALUE))])
	(AND ZTRACEDFNS 
	     [ZBREAK1 (CONS (CAR Z-L) '(PROCS)) '"Leave " ZVALUE -3.])
	(COND [(AND [NEQ ZVALUE FAIL] [ZRANGEP (ZVALZ ZVALUE) Z-R])
	       (SETQ ZDEDUCEV Z-L)
	       (RETURN (SETQ ZVALD ZVALUE))])
	(COND [(NOT ZRESETV) (ZRESTORE ZSAVED) (GO LOOP)])
  RETRY (AND ZTRACEDFNS 
	     [ZBREAK1 (CONS (CAR Z-L) '(PROCS)) '"Reenter " Z-PAT 3.])
	(PROG (ZALIST ZNAME) (ZPROC NIL NIL NIL NIL))
	(GO TRY)))
 EXPR)

(DEFPROP DEMON:
 (LAMBDA (Z-NM) (ZPROCN (CAR Z-NM) 'DEMON: (FUNCTION CDDR) (CDR Z-NM)))
 FEXPR)

(DEFPROP DO?
 (LAMBDA (Z-L)
  (PROG (Z-SAVE Z-V)
	(SETQ Z-SAVE ZSAVE)
	(SETQ Z-V (APPLY# (FUNCTION PROGN) Z-L))
	(ZRESTORE Z-SAVE)
	(RETURN Z-V)))
 FEXPR)

(DEFPROP DO!
 (LAMBDA (Z-L)
  (PROG (Z-SAVE Z-V)
	(SETQ Z-SAVE ZSAVE)
	(SETQ Z-V (APPLY# (FUNCTION PROGN) Z-L))
	(SETQ ZSAVE Z-SAVE)
	(RETURN Z-V)))
 FEXPR)

(DEFPROP ZERROR
 (LAMBDA Z-L
  (PROG (Z-N Z-F)
	(SETQ Z-F (OUTC NIL NIL))
	(TERPRI)
	(SETQ Z-N 1.)
   LOOP (COND [(GREATERP Z-N Z-L)
	       (RETURN (PROG1 (BREAK1 NIL T 'FUZZY NIL NIL) (OUTC Z-F NIL)))]
	      [(ATOM (ARG Z-N)) (PRINC (ARG Z-N))]
	      [T (SPRINT (ARG Z-N) (CHRPOS))])
	(SETQ Z-N (ADD1 Z-N))
	(GO LOOP)))
 EXPR)

(DEFPROP ERASE
 (LAMBDA (Z-DAT)
  (PROG (Z-SAVE)
	(SETQ Z-SAVE ZSAVE)
	(COND [(EQ (SETQ Z-DAT (ZREMOVE (ZINST (CAR Z-DAT)))) FAIL)
	       (RETURN FAIL)])
	(RETURN (ZCALLEM Z-SAVE EPROCS Z-DAT))))
 FEXPR)

(DEFP *EXIT EXIT SUBR)

(DEFPROP EXIT (LAMBDA (Z-L) (ZSETV Z-L) (THROW NIL EXIT)) FEXPR)

(DEFPROP FAIL
 (LAMBDA Z-C
  (COND [(ZEROP Z-C) (RESTORE)] [T (RESTORE (ARG 1.))])
  (SETQ ZVALUE FAIL)
  (THROW NIL SUCCEED))
 EXPR)

(DEFV FAIL FAIL)

(DEFPROP FAILP (LAMBDA (X) (EQ X 'FAIL)) EXPR)

(DEFPROP FETCH
 (LAMBDA (Z-PAT)
  (PROG (Z-R)
	(SETQ Z-R (ZRANGES (CDR Z-PAT)))
	(SETQ Z-PAT (ZINSTP (CAR Z-PAT)))
	(RETURN (ZFETCH Z-PAT ZINSTPF (ZGETAS Z-PAT Z-R) (ZRANGER Z-R)))))
 FEXPR)

(DEFPROP ZFETCH
 (LAMBDA (Z-PAT Z-I Z-L Z-R)
  (PROG NIL
	(COND [(NULL Z-L) (RETURN FAIL)]
	      [Z-I (GO LOOP)]
	      [(AND [SETQ Z-PAT (ASSOC# Z-PAT Z-L)] [ZRANGEP (CDR Z-PAT) Z-R])
	       (AND ZTRACEDFNS [ZBREAK1 '(FETCH NET) NIL Z-PAT 0.])
	       (SETQ ZFETCHV NIL)
	       (RETURN (SETQ ZVALD (ZCAR Z-PAT)))]
	      [T (RETURN FAIL)])
   LOOP (COND [(NOT (ZRANGEP (CDAR Z-L) Z-R)) (RETURN FAIL)]
	      [(ZMATCH Z-PAT (CAAR Z-L))
	       (AND ZTRACEDFNS [ZBREAK1 '(FETCH NET) NIL (CAR Z-L) 0.])
	       (SETQ ZFETCHV (CDR Z-L))
	       (RETURN (SETQ ZVALD (ZCAR (CAR Z-L))))]
	      [(SETQ Z-L (CDR Z-L)) (GO LOOP)]
	      [T (RETURN FAIL)])))
 EXPR)

(DEFPROP FINALIZE
 (LAMBDA Z-C
  (SETQ Z-C (COND [(ZEROP Z-C) ZSAVEP] [T (ARG 1.)]))
  (COND [(NOT (TAILP Z-C ZSAVE)) (ZERROR '"BACKTRACK ERROR - FINALIZE")]
	[T (SETQ ZSAVE Z-C)])
  T)
 EXPR)

(DEFPROP FLUSH
 (LAMBDA (Z-F)
  (COND [(OR [NULL Z-F] [EQ (CAR Z-F) 'NET])
	 (RPLACD ZNET NIL)
	 (MAPATOMS (FUNCTION (LAMBDA (Z-A) (REMPROP Z-A ZINDEX))))])
  (COND [(OR [NULL Z-F] [EQ (CAR Z-F) 'PROCS])
	 (RPLACD DPROCS NIL)
	 (RPLACD EPROCS NIL)
	 (RPLACD APROCS NIL)])
  (SETQ ZSAVE ZSAVEP)
  T)
 FEXPR)

(DEFPROP FOR
 (LAMBDA (Z-L)
  (SETQ ZRESETV NIL)
  (PROG (Z-A1 Z-A2)
	(SETQ Z-A1 (CAR Z-L))
	(SETQ Z-A2 (CADR Z-L))
	(SETQ Z-L (CDDR Z-L))
	(COND [(OR [EQ Z-A1 'FETCH:] [EQ Z-A1 'F:]) (SETQ Z-A1 NIL)]
	      [(OR [EQ Z-A1 'DEDUCE:] [EQ Z-A1 'D:]) (SETQ Z-A1 'D)]
	      [(OR [EQ Z-A1 'GOAL:] [EQ Z-A1 'G:]) (SETQ Z-A1 T)]
	      [(OR [EQ Z-A1 'TRY:] [EQ Z-A1 'T:])
	       (SETQ Z-A1 (CONS Z*NIL* (ZINST Z-A2)))
	       (SETQ Z-A2 (CAR Z-L))
	       (SETQ Z-L (CDR Z-L))]
	      [T (RETURN (ZFOR (ZINSTP Z-A1) (ZINST Z-A2) Z-L))])
	(RETURN (ZFORFD (ZINSTP Z-A2) Z-L Z-A1))))
 FEXPR)

(DEFPROP ZFOR
 (LAMBDA (ZPAT ZDATS ZLIST)
  (PROG (ZLIST1 ZSAVEF)
	(COND [ZRESETV (COND [(EQ (ZRESET '(ZPAT ZDATS ZLIST ZLIST1 ZSAVEF))
				  Z*NIL*)
			      (GO NEXT)]
			     [T (GO EVAL)])])
	(AND [NULL ZDATS] [RETURN FAIL])
	(SETQ ZSAVEF ZSAVE)
	(SETQ ZLIST1 ZLIST)
	(SETQ ZVALUE FAIL)
   LOOP (COND [(NOT (ZMATCH ZPAT (ZVALV (SETQ ZVALD (CAR ZDATS)))))
	       (GO ITER)])
     LP (SETQ ZVALUE (CAR ZLIST))
   EVAL (CATCH [SETQ ZVALUE (EVAL ZVALUE)]
	       [SUCCEED? (GO SUCCEED?)]
	       [EXIT (GO EXIT)]
	       [NEXT (GO NXT)]
	       [BACK (GO BACK)])
	(COND [(EQ ZVALUE FAIL) (GO BACK)] [T (ZCALLD ZVALUE)])
   NEXT (COND [(SETQ ZLIST (CDR ZLIST)) (GO LP)]
	      [T (SETQ ZVALUE FAIL) (GO BACK)])
 SUCCEED? 
	(SETQ ZRESETV
	      (CONS 'ZFOR (CONS (LIST ZPAT ZDATS ZLIST ZLIST1 ZSAVEF) ZRESETV)))
	(THROW NIL SUCCEED?)
   EXIT (COND [(EQ ZVALUE Z*NIL*) (SETQ ZVALUE (CAR ZDATS))])
	(RETURN (ZCAR ZVALUE))
    NXT (COND [(EQ ZVALUE Z*NIL*) (SETQ ZVALUE (CAR ZDATS))])
	(GO ITER)
   BACK (ZRESTORE ZSAVEF)
   ITER (COND [(SETQ ZDATS (CDR ZDATS)) (SETQ ZLIST ZLIST1) (GO LOOP)]
	      [T (RETURN (ZCAR ZVALUE))])))
 EXPR)

(DEFPROP ZFORFD
 (LAMBDA (ZPAT ZLIST ZPROCS)
  (PROG (ZDATS ZLIST1 ZRNG ZRSETV ZVLD ZSAVEF ZSAVF1 Z-B Z-I Z-T)
	(SETQ Z-I T)
	(COND [ZRESETV (COND [(EQ (ZRESET '(ZPAT ZLIST ZPROCS ZDATS ZLIST1 ZRNG
						 ZRSETV ZVLD ZSAVEF ZSAVF1))
				  Z*NIL*)
			      (GO NEXT)]
			     [T (GO EVAL)])]
	      [(EQ (CAR ZLIST) 'ZVAL:)
	       (SETQ ZRNG (ZRANGES (CDR ZLIST)))
	       (SETQ ZLIST (CDDR ZLIST))]
	      [T (SETQ ZRNG ZRANGE)])
	(SETQ ZSAVEF ZSAVE)
	(COND [(EQ ZPROCS 'D) (SETQ ZPROCS DPROCS) (SETQ ZPAT (ZINSTD ZPAT))]
	      [(EQ (CAR ZPROCS) Z*NIL*) (SETQ ZPAT (ZINSTD ZPAT))]
	      [T (SETQ Z-I ZINSTPF) (SETQ ZDATS (ZGETAS ZPAT ZRNG))])
	(SETQ ZRNG (ZRANGER ZRNG))
	(SETQ ZLIST1 ZLIST)
	(SETQ Z-T FAIL)
   LOOP (COND [ZDATS (COND [(EQ (ZFETCH ZPAT Z-I ZDATS ZRNG) FAIL)
			    (SETQ ZDATS NIL)]
			   [T (SETQ ZDATS ZFETCHV) (GO CALLD)])])
	(COND [(EQ ZPROCS T) (SETQ ZPROCS DPROCS) (SETQ ZPAT (ZINSTD ZPAT))])
	(SETQ ZRESETV ZRSETV)
	(COND [(OR [NULL ZPROCS] [EQ (ZDEDUCE ZPAT ZPROCS ZRNG) FAIL])
	       (COND [Z-B (ZRESTORE ZSAVEF)])
	       (RETURN (ZCAR Z-T))]
	      [T (SETQ ZPROCS ZDEDUCEV)
		 (SETQ ZRSETV ZRESETV)
		 (SETQ ZSAVF1 ZSAVE)])
  CALLD (ZCALLD (SETQ ZVLD ZVALD))
	(SETQ Z-B NIL)
     LP (SETQ ZVALUE (CAR ZLIST))
   EVAL (CATCH [SETQ ZVALUE (EVAL ZVALUE)]
	       [SUCCEED? (GO SUCCEED?)]
	       [EXIT (GO EXIT)]
	       [NEXT (GO NXT)]
	       [BACK (GO BACK)])
	(COND [(EQ ZVALUE FAIL) (GO BACK)] [T (ZCALLD ZVALUE)])
   NEXT (COND [(SETQ ZLIST (CDR ZLIST)) (GO LP)]
	      [T (SETQ ZVALUE FAIL) (GO BACK)])
 SUCCEED? 
	(SETQ ZRESETV
	      (CONS 'ZFORFD
		    (CONS (LIST ZPAT ZLIST ZPROCS ZDATS ZLIST1 ZRNG ZRSETV ZVLD
				ZSAVEF ZSAVF1)
			  ZRESETV)))
	(THROW NIL SUCCEED?)
   EXIT (COND [(EQ ZVALUE Z*NIL*) (SETQ ZVALUE ZVLD)])
	(RETURN (ZCAR ZVALUE))
    NXT (COND [(EQ ZVALUE Z*NIL*) (SETQ ZVALUE ZVLD)])
	(GO ITER)
   BACK (COND [ZRSETV (ZRESTORE ZSAVF1) (SETQ Z-B T)] [T (ZRESTORE ZSAVEF)])
   ITER (SETQ ZLIST ZLIST1)
	(SETQ Z-T ZVALUE)
	(GO LOOP)))
 EXPR)

(DEFPROP ZGENPROC
 (LAMBDA NIL
  (PROG (BASE *NOPOINT)
	(SETQ BASE 10.)
	(SETQ *NOPOINT T)
	(SETQ ZGENPROCS
	      (CONS (READLIST (APPEND '($ P R O C)
				      (EXPLODE (SETQ ZGENPROCN (ADD1 ZGENPROCN))
				       )))
		    ZGENPROCS))
	(RETURN (CAR ZGENPROCS))))
 EXPR)

(DEFPROP ZGET
 (LAMBDA (AT PROP) (AND [SETQ AT (GET AT PROP)] [CDR AT]))
 EXPR)

(DEFPROP ZGETAS
 (LAMBDA (Z-P Z-R)
  (PROG (Z-AL Z-L Z-N Z-N1)
	(SETQ Z-AL (ZATOMS Z-P))
	(SETQ Z-L (CDR ZNET))
	(SETQ Z-N 4096.)
   LOOP (COND [(NULL Z-AL) (GO OK)]
	      [(OR [NULL (SETQ Z-P (GET (CAR Z-AL) ZINDEX))]
		   [ZEROP (SETQ Z-N1 (CDAR Z-P))])
	       (RETURN NIL)]
	      [(LESSP Z-N1 Z-N) (SETQ Z-N Z-N1) (SETQ Z-L (CDR Z-P))])
	(SETQ Z-AL (CDR Z-AL))
	(GO LOOP)
     OK (COND [(LESSP (SETQ Z-N (CAR Z-R)) (CADR Z-R))
	       (SETQ Z-AL T)
	       (SETQ Z-L (REVERSE Z-L))])
	(AND [NULL Z-L] [RETURN NIL])
   MOVE (COND [Z-AL (COND [(LESSP (CDAR Z-L) Z-N) (GO NEXT)])]
	      [(GREATERP (CDAR Z-L) Z-N) (GO NEXT)])
	(RETURN Z-L)
   NEXT (COND [(SETQ Z-L (CDR Z-L)) (GO MOVE)] [T (RETURN NIL)])))
 EXPR)

(DEFPROP GLOBAL (LAMBDA (Z-L) (SETQ ZGLOBEV Z-L) T) FEXPR)

(DEFPROP ZGLOBE
 (LAMBDA (Z-L)
  (MAPCAR (FUNCTION (LAMBDA (Z-A) (ZLOOK (CADR Z-A))))
	  (APPEND Z-L ZGLOBEV)))
 EXPR)

(DEFPROP GOAL
 (LAMBDA (Z-PAT)
  (PROG (Z-R)
	(SETQ Z-R (ZRANGES (CDR Z-PAT)))
	(SETQ Z-PAT (ZINSTP (CAR Z-PAT)))
	(RETURN (COND [(NEQ (ZFETCH Z-PAT 
				    ZINSTPF 
				    (ZGETAS Z-PAT Z-R)
				    (SETQ Z-R (ZRANGER Z-R)))
			    FAIL)
		       ZVALD]
		      [T (SETQ ZRESETV NIL) (ZDEDUCE (ZINSTD Z-PAT) DPROCS Z-R)]
		 ))))
 FEXPR)

(DEFPROP GOTO
 (LAMBDA (Z-L)
  (SETQ Z-L (CAR Z-L))
  (PROG NIL
   LOOP (COND [(ATOM Z-L) (THROW Z-L GOTO)]
	      [T (SETQ Z-L (EVAL Z-L)) (GO LOOP)])))
 FEXPR)

(DEFPROP IFALL
 (LAMBDA (Z-L)
  (PROG (Z-A Z-V)
   LOOP (COND [(OR [NULL Z-L] [EQ (SETQ Z-A (CAR Z-L)) 'ELSE:]) (RETURN Z-V)]
	      [(EQ Z-A 'THEN:) (GO DOIT)]
	      [(AND [SETQ Z-V (EVAL Z-A)] [NEQ Z-V FAIL])
	       (SETQ Z-L (CDR Z-L))
	       (GO LOOP)]
	      [(NOT (SETQ Z-L (MEMB 'ELSE: Z-L))) (RETURN FAIL)])
   DOIT (COND [(OR [NULL (SETQ Z-L (CDR Z-L))] [EQ (SETQ Z-A (CAR Z-L)) 'ELSE:])
	       (RETURN Z-V)]
	      [T (SETQ Z-V (EVAL Z-A)) (GO DOIT)])))
 FEXPR)

(DEFP IF IFALL (FEXPR FSUBR))

(DEFPROP IFANY
 (LAMBDA (Z-L)
  (PROG (Z-A Z-V)
   LOOP (COND [(NULL Z-L) (RETURN FAIL)]
	      [(EQ (SETQ Z-A (CAR Z-L)) 'ELSE:) (GO DOIT)]
	      [(EQ Z-A 'THEN:)
	       (COND [(SETQ Z-L (MEMB 'ELSE: Z-L)) (GO DOIT)] [T (RETURN FAIL)])
	       ]
	      [(OR [NULL (SETQ Z-V (EVAL Z-A))] [EQ Z-V FAIL])
	       (SETQ Z-L (CDR Z-L))
	       (GO LOOP)]
	      [(NOT (SETQ Z-L (MEMB 'THEN: Z-L))) (RETURN Z-V)])
   DOIT (COND [(OR [NULL (SETQ Z-L (CDR Z-L))] [EQ (SETQ Z-A (CAR Z-L)) 'ELSE:])
	       (RETURN Z-V)]
	      [T (SETQ Z-V (EVAL Z-A)) (GO DOIT)])))
 FEXPR)

(DEFPROP ZINST
 (LAMBDA (Z-DAT) 		       {; Complete instantiation⎇
  (SETQ ZINSTF NIL)
  (ZINST1 Z-DAT))
 EXPR)

(DEFPROP ZINSTP
 (LAMBDA (Z-DAT) 		       {; Pattern instantiation - instantiate 
					  *! *& QUOTE etc but leave other 
					  patterns alone⎇
  (SETQ ZINSTF 'P)
  (SETQ ZINSTPF NIL)
  (ZINST1 Z-DAT))
 EXPR)

(DEFPROP ZINSTD
 (LAMBDA (Z-DAT) 		       {; Deduce pattern instantiation - only 
					  allow *? type patterns⎇
  (SETQ ZINSTF 'D)
  (ZINST1 Z-DAT))
 EXPR)

(DEFPROP ZINSTR
 (LAMBDA (Z-DAT) 		       {; Re-instantiate deduce pattern - 
					  change *? to *!⎇
  (SETQ ZINSTF 'R)
  (ZINST1 Z-DAT))
 EXPR)

(DEFPROP ZINSTPD
 (LAMBDA (Z-DAT) 		       {; ZINSTP and ZINSTD combined - only 
					  need ZINSTD if pattern functions 
					  present⎇
  (SETQ Z-DAT (ZINSTP Z-DAT))
  (COND [ZINSTPF (ZINSTD Z-DAT)] [T Z-DAT]))
 EXPR)

(DEFPROP ZINST1
 (LAMBDA (Z-DAT)
  (PROG (Z-C Z-F)
   LOOP (COND [(EQ ZINSTF 'P) (COND [(ZINSTP? Z-DAT) (RETURN Z-DAT)])]
	      [(ZINST? Z-DAT) (RETURN Z-DAT)])
	(COND [(ATOM (SETQ Z-C (CAR Z-DAT)))
	       (COND [(OR [NOT (LITATOM Z-C)] [NOT (GET Z-C 'ZPATF)]) (GO CONS)]
		     [(EQ Z-C 'QUOTE) (RETURN (CADR Z-DAT))]
		     [(SETQ Z-F (GET Z-C 'ZPATEI))
		      (SETQ Z-DAT (Z-F (CADR Z-DAT)))
		      (GO LOOP)]
		     [(EQ ZINSTF 'R) (RETURN (ZLOOK! (CADR Z-DAT)))]
		     [(AND [EQ ZINSTF 'D] [EQ Z-C '*?])
		      (COND [(NULL (CDR Z-DAT))
			     (SETQ Z-DAT (LIST '*? (GENSYM)))])
		      (ZLOOK (CADR Z-DAT))
		      (RETURN Z-DAT)]
		     [T (SETQ Z-DAT (ZERROR '"CAN'T INSTANTIATE " Z-DAT))
			(GO LOOP)])]
	      [(AND [LITATOM (SETQ Z-F (CAR Z-C))] [SETQ Z-F (GET Z-F 'ZPATES)])
	       (SETQ Z-DAT (APPEND (Z-F (CADR Z-C)) (CDR Z-DAT)))
	       (GO LOOP)]
	      [T (SETQ Z-C (ZINST1 Z-C))])
   CONS (RETURN (CONS Z-C (ZINST1 (CDR Z-DAT))))))
 EXPR)

(DEFPROP ZINST?
 (LAMBDA (Z-DAT) 		       {; Returns T if arg completely 
					  instantiated⎇
  (SETQ ZINST?F T)
  (SETQ ZTEMPV (ZVALV Z-DAT))
  (CATCH [ZINST?1 ZTEMPV]))
 EXPR)

(DEFPROP ZINSTP?
 (LAMBDA (Z-DAT) 		       {; Returns T if arg is a pattern with 
					  no *! *& QUOTE etc⎇
  (SETQ ZINST?F NIL)
  (SETQ ZTEMPV (ZVALV Z-DAT))
  (CATCH [ZINST?1 ZTEMPV]))
 EXPR)

(DEFPROP ZINST?1
 (LAMBDA (Z-DAT)
  (PROG (Z-C)
	(RETURN (COND [(ATOM Z-DAT) T]
		      [(AND [LITATOM (SETQ Z-C (CAR Z-DAT))] [GET Z-C 'ZPATF])
		       (COND [(OR ZINST?F 
				  [EQ Z-C 'QUOTE]
				  [GET Z-C 'ZPATEI]
				  [GET Z-C 'ZPATES])
			      (THROW NIL)]
			     [T (SETQ ZINSTPF T)])]
		      [T (MAPC (FUNCTION ZINST?1) Z-DAT) T]))))
 EXPR)

(DEFPROP ZLOOK
 (LAMBDA (Z-A)
  (COND [(ASSOC Z-A ZALIST)]
	[T (SETQ ZALIST (CONS (SETQ Z-A (CONS Z-A (CONS NIL Z*NIL*))) ZALIST))
	   Z-A]))
 EXPR)

(DEFPROP ZLOOK!
 (LAMBDA (Z-A)
  (COND [(ZLOOK? Z-A) ZLOOKV] [T (ZERROR '"UNBOUND !" Z-A)]))
 EXPR)

(DEFPROP ZLOOK?
 (LAMBDA (Z-A) (NEQ (SETQ ZLOOKV (CDDR (ZLOOK Z-A))) Z*NIL*))
 EXPR)

(DEFPROP MATCH
 (LAMBDA (Z-PAT)
  (COND [(ZMATCH (ZINSTP (CAR Z-PAT)) (ZVALV (SETQ Z-PAT (ZINST (CADR Z-PAT)))))
	 Z-PAT]
	[T FAIL]))
 FEXPR)

(DEFPROP ZMATCH
 (LAMBDA (Z-PAT Z-DAT)
  (PROG (Z-SAVE)
	(SETQ Z-SAVE ZSAVE)
	(SETQ ZTEMPV Z-PAT)
	(SETQ ZTEMP2 Z-DAT)
	(CATCH [ZMATCH1 ZTEMPV ZTEMP2] [MATCH (ZRESTORE Z-SAVE) (RETURN NIL)])
	(RETURN T)))
 EXPR)

(DEFPROP ZMATCH1
 (LAMBDA (Z-PAT Z-DAT)
  (PROG (Z-C Z-C1 Z-F)
	(COND [(AND [NOT (ATOM Z-PAT)] [EQ (SETQ Z-C (CAR Z-PAT)) '*?Q])
	       (RETURN (ZBIND (CADR Z-PAT) Z-DAT))]
	      [(AND [NOT (ATOM Z-DAT)] [EQ (CAR Z-DAT) '*?])
	       (SETQ Z-DAT (CDR (ASSOC (CADR Z-DAT) ZALIST1)))
	       (COND [(ZINST? Z-PAT) (RETURN (ZPLACD Z-DAT Z-PAT))]
		     [(AND [EQ (CAR Z-PAT) '*?] [CDR Z-PAT])
		      (ZPLACD (ZLOOK (CADR Z-PAT)) Z-DAT)
		      (RETURN (ZPLACD Z-DAT Z*NIL*))]
		     [T (THROW NIL MATCH)])]
	      [(ATOM Z-PAT) (GO ATOM)]
	      [(NOT (ATOM Z-C)) (GO GO)]
	      [(OR [NOT (LITATOM Z-C)] [NOT (GET Z-C 'ZPATF)]) (GO MCAR)]
	      [(NOT (SETQ Z-F (GET Z-C 'ZPATMI)))
	       (ZERROR '"ILLEGAL PATTERN: " Z-PAT)]
	      [(ZINST? Z-DAT) (RETURN (Z-F (CDR Z-PAT) Z-DAT))]
	      [T (THROW NIL MATCH)])
   LOOP (COND [(ATOM Z-PAT) (GO ATOM)]
	      [(ATOM (SETQ Z-C (CAR Z-PAT))) (GO MCAR)])
     GO (COND [(AND [LITATOM (SETQ Z-C1 (CAR Z-C))] [GET Z-C1 'ZPATF])
	       (COND [(AND Z-DAT [ATOM Z-DAT]) (THROW NIL MATCH)]
		     [(SETQ Z-F (GET Z-C1 'ZPATMS))
		      (RETURN (Z-F (CDR Z-C) (CDR Z-PAT) Z-DAT))])])
   MCAR (COND [(ATOM Z-DAT) (THROW NIL MATCH)])
	(ZMATCH1 Z-C (CAR Z-DAT))
	(SETQ Z-DAT (CDR Z-DAT))
	(SETQ Z-PAT (CDR Z-PAT))
	(GO LOOP)
   ATOM (COND [(EQUAL Z-PAT Z-DAT) (RETURN T)] [T (THROW NIL MATCH)])))
 EXPR)

(DEFPROP ZMEMB
 (LAMBDA (Z-A Z-L)
  (PROG (Z-N)
   LOOP (COND [(NULL (SETQ Z-N (CDR Z-L))) (RETURN NIL)]
	      [(EQ Z-A (CAR Z-N)) (RETURN Z-L)]
	      [T (SETQ Z-L Z-N) (GO LOOP)])))
 EXPR)

(DEFPROP ZMEMBC
 (LAMBDA (Z-A Z-L)
  (PROG (Z-N)
   LOOP (COND [(NULL (SETQ Z-N (CDR Z-L))) (RETURN NIL)]
	      [(EQUAL Z-A (CAAR Z-N)) (RETURN Z-L)]
	      [T (SETQ Z-L Z-N) (GO LOOP)])))
 EXPR)

(DEFPROP ZMEMBN
 (LAMBDA (Z-A Z-L)
  (PROG (Z-N)
   LOOP (COND [(NULL (SETQ Z-N (CDR Z-L))) (RETURN Z-L)]
	      [(GREATERP (CDAR Z-N) Z-A) (SETQ Z-L Z-N) (GO LOOP)]
	      [T (RETURN Z-L)])))
 EXPR)

(DEFPROP NETADD
 (LAMBDA (Z-L)
  (MAPC (FUNCTION (LAMBDA (Z-A) (ZREMOVE (CAR Z-A)))) (CADR Z-L))
  (MAPC (FUNCTION (LAMBDA (Z-A) (ZADD (CAR Z-A) (CDR Z-A)))) (CAR Z-L)))
 EXPR)

(DEFPROP NETDIF
 (LAMBDA Z-L (ZNETDIF (COND [(ZEROP Z-L) ZSAVEP] [T (ARG 1.)])))
 EXPR)

(DEFPROP ZNETDIF
 (LAMBDA (Z-L)
  (PROG (Z-A Z-R Z-T Z-SAVE Z-SAVE1)
	(SETQ Z-SAVE (SETQ Z-SAVE1 ZSAVE))
   LOOP (COND [(EQ Z-L Z-SAVE) (ZRESTORE Z-SAVE1) (RETURN (LIST Z-A Z-R))]
	      [(NULL Z-SAVE) (ZERROR '"NETDIF ERROR")]
	      [(TAILP (CAAR Z-SAVE) ZNET)
	       (COND [(EQ (CDDAAR Z-SAVE) (CDAR Z-SAVE))
		      (COND [(MEMB (CADAAR Z-SAVE) Z-R)
			     (SETQ Z-R (DREMOVE (CADAAR Z-SAVE) Z-R))]
			    [T (SETQ Z-A (CONS (CADAAR Z-SAVE) Z-A))])]
		     [(SETQ Z-T (MEMBER (CADAR Z-SAVE) Z-A))
		      (SETQ Z-A (DREMOVE (CAR Z-T) Z-A))]
		     [T (SETQ Z-R (CONS (CADAR Z-SAVE) Z-R))])
	       (ZPLACD (CAAR Z-SAVE) (CDAR Z-SAVE))])
	(SETQ Z-SAVE (CDR Z-SAVE))
	(GO LOOP)))
 EXPR)

(DEFPROP NEXT (LAMBDA (Z-L) (ZSETV Z-L) (THROW NIL NEXT)) FEXPR)

(DEFPROP NOHASH (LAMBDA (Z-L) (PUTLIST Z-L T 'NOHASH)) FEXPR)

(DEFPROP ZNOT
 (LAMBDA (Z-E)
  (ZCONS (ZVALV Z-E) (DIFFERENCE (PLUS ZLOW ZHIGH) (ZVALZ Z-E))))
 EXPR)

(DEFPROP ZOR (LAMBDA (Z-L) (ZANDOR Z-L ZLOW NIL)) FEXPR)

(DEFPROP ZPLACD
 (LAMBDA (Z-L Z-E)
  (COND [(NEQ Z-E (CDR Z-L))
	 (SETQ ZSAVE (CONS (CONS Z-L (CDR Z-L)) ZSAVE))
	 (RPLACD Z-L Z-E)]))
 EXPR)

(DEFPROP POP
 (LAMBDA (Z-V)
  (SETQ Z-V (CAR Z-V))
  (PROG (Z-A)
	(COND [(ATOM (SETQ Z-A (EVAL Z-V)))
	       (ZERROR '"CAN'T POP " Z-V '" = " Z-A)]
	      [T (ZSET Z-V (CDR Z-A)) (RETURN (CAR Z-A))])))
 FEXPR)

(DEFPROP POP
 (LAMBDA (L)
  (LIST 'PROG1
	(LIST 'CAR (CADR L))
	(LIST 'SETQ (CADR L) (LIST 'CDR (CADR L)))))
 MACRO)

(DEFPROP PROC
 (LAMBDA (Z-L)
  (PROG (Z-L1 Z-P Z-V Z-NM Z-GL Z-DE Z-TH Z-AC)
	(SETQ Z-L1 Z-L)
	(SETQ Z-DE DEFDEMON)
   LOOP (SETQ Z-P (CAR Z-L))
	(SETQ Z-V (CADR Z-L))
	(COND [(EQ Z-P 'NAME:) (SETQ Z-NM Z-V)]
	      [(EQ Z-P 'GLOBAL:) (SETQ Z-GL Z-V)]
	      [(EQ Z-P 'DEMON:)
	       (SETQ Z-DE (COND [(ATOM Z-V) Z-V] [T (EVAL Z-V)]))]
	      [(MEMB Z-P '(THRESH: ZVAL:)) (SETQ Z-TH (EVAL Z-V))]
	      [(EQ Z-P 'ACCUM:) (SETQ Z-AC (EVAL Z-V))]
	      [Z-NM (GO OK)]
	      [T (SETQ Z-NM (ZGENPROC))
		 (SETQ Z-L1 (CONS 'NAME: (CONS Z-NM Z-L1)))
		 (GO OK)])
	(SETQ Z-L (CDDR Z-L))
	(GO LOOP)
     OK (COND [(NULL Z-TH) (SETQ Z-TH (OR [GET Z-DE 'DEFZVAL] DEFZVAL))])
	(COND [(NULL Z-AC) (SETQ Z-AC (OR [GET Z-DE 'DEFACCUM] DEFACCUM))])
	(PUT Z-NM (CONS 'PROC Z-L1) 'PROC)
	(PUT Z-NM (LIST Z-P Z-GL Z-DE Z-TH Z-AC (CDR Z-L)) 'PDEF)
	(PUT Z-NM 
	     (LIST 'LAMBDA
		   '(SKELETON)
		   (LIST 'ZCALL (LIST 'QUOTE Z-NM) '(ZINSTPD (CAR SKELETON))))
	     'FEXPR)
	(OR [INCH] [SETQ ALLFNS (ENTER Z-NM ALLFNS)])
	(RETURN Z-NM)))
 FEXPR)

(DEFPROP *DEMON
 (LAMBDA (Z-E Z-TH Z-AC)
  (COND [(EQ Z-E FAIL) (FAIL)]
	[(EQ Z-E DONE) Z-AC]
	[(*LESS (SETQ Z-E (ZVALZ Z-E)) Z-TH) (FAIL)]
	[T (*MIN Z-E Z-AC)]))
 EXPR)

(DEFPROP ZPROCN
 (LAMBDA (Z-NM Z-L Z-C Z-V)
  (PROG (Z-D Z-D1)
	(COND [(NOT (ATOM Z-NM)) (SETQ Z-NM (EVAL Z-NM))])
   REDO (COND [(NOT (SETQ Z-D (GET Z-NM 'PDEF)))
	       (SETQ Z-NM (ZERROR Z-NM '" IS NOT A PROC"))
	       (GO REDO)])
	(SETQ Z-C (CAR (SETQ Z-D (Z-C Z-D))))
	(COND [(NULL Z-V) (RETURN Z-C)]
	      [T (RPLACA Z-D (EVAL (SETQ Z-V (CAR Z-V))))])
	(COND [(SETQ Z-D1 (MEMB Z-L (SETQ Z-D (GET Z-NM 'PROC))))
	       (RPLACA (CDR Z-D1) Z-V)]
	      [T (RPLACD (CDDR Z-D) (CONS Z-L (CONS Z-V (CDDDR Z-D))))])
	(AND [EQ Z-L 'DEMON:] [EVAL Z-D])
	(RETURN Z-C)))
 EXPR)

(DEFPROP ZPROC
 (LAMBDA (ZDEMON ZTHRSH ZACCUM ZLIST)
  (PROG (ZLIST1 ZSAVEP)
	(COND [ZRESETV (COND [(EQ (ZRESET '(ZSAVED ZALIST ZNAME ZDEMON ZTHRSH
						   ZACCUM ZLIST ZLIST1 ZSAVEP))
				  Z*NIL*)
			      (GO NEXT)]
			     [T (GO EVAL)])])
	(SETQ ZSAVEP ZSAVE)
	(SETQ ZLIST1 ZLIST)
   LOOP (COND [(ATOM (SETQ ZVALUE (CAR ZLIST))) (GO NEXT)])
   EVAL (CATCH [ZCALLD (EVAL ZVALUE)]
	       [GOTO (GO GOTO)]
	       [SUCCEED (GO SUCCEED)]
	       [SUCCEED? (GO SUCCEED?)]
	       [EXIT (ZERROR '"EXIT - NO FOR")]
	       [NEXT (ZERROR '"NEXT - NO FOR")]
	       [BACK (ZERROR '"BACK - NO FOR")])
   NEXT (COND [(SETQ ZLIST (CDR ZLIST)) (GO LOOP)] [T (SETQ ZVALUE Z*NIL*)])
 SUCCEED 
	(SETQ ZRESETV NIL)
	(GO DONE)
   GOTO (COND [(SETQ ZLIST (MEMB THROW ZLIST1)) (GO NEXT)]
	      [T (SETQ THROW (ZERROR '"GOTO " THROW '" ILLEGAL")) (GO GOTO)])
 SUCCEED? 
	(SETQ ZRESETV
	      (CONS (LIST ZSAVED ZALIST ZNAME ZDEMON ZTHRSH ZACCUM ZLIST ZLIST1
			  ZSAVEP)
		    ZRESETV))
   DONE (ZCALLD DONE)
	(COND [(EQ ZVALUE Z*NIL*) (SETQ ZVALUE (CONS Z*NIL* ZACCUM))])
	(RETURN ZVALUE)))
 EXPR)

(DEFPROP ZPROC?
 (LAMBDA (Z-A)
  (COND [(OR [EQ Z-A 'DEDUCE:] [EQ Z-A 'D:]) DPROCS]
	[(OR [EQ Z-A 'ASSERT:] [EQ Z-A 'A:]) APROCS]
	[(OR [EQ Z-A 'ERASE:] [EQ Z-A 'E:]) EPROCS]))
 EXPR)

(DEFPROP PUSH
 (LAMBDA (Z-V)
  (ZSET (CAR Z-V) (CONS (EVAL (CADR Z-V)) (EVAL (CAR Z-V)))))
 FEXPR)

(DEFPROP PUSH
 (LAMBDA (L) (LIST 'SETQ (CADR L) (LIST 'CONS (CADDR L) (CADR L))))
 MACRO)

(DEFPROP PUSH PP-SPECIAL PRINTMACRO)

(DEFPROP PUSH?
 (LAMBDA (L)
  (PROG (OLD NEW)
	(COND [(MEMBER (SETQ NEW (EVAL (CADR L))) (SETQ OLD (EVAL (CAR L))))
	       (RETURN OLD)]
	      [T (RETURN (ZSET (CAR L) (CONS NEW OLD)))])))
 FEXPR)

(DEFPROP ZPUT
 (LAMBDA (AT VAL PROP)
  (ZPLACD (OR [GET AT PROP] [PUT AT (NCONS) PROP]) VAL)
  VAL)
 EXPR)

(DEFPROP RANGE
 (LAMBDA (X Y)
  (AND [*GREAT X Y] [SETQ X (PROG1 Y (SETQ Y X))])
  (SETQ ZLOW X)
  (SETQ ZHIGH Y)
  (SETQ ZRANGE (LIST Y X))
  (SETQ DEFZVAL X)
  (SETQ DEFACCUM Y)
  T)
 EXPR)

(DEFPROP ZRANGEP
 (LAMBDA (Z-Z Z-R)
  (COND [(GREATERP Z-Z (CAR Z-R)) NIL] [(LESSP Z-Z (CADR Z-R)) NIL] [T]))
 EXPR)

(DEFPROP ZRANGER
 (LAMBDA (Z-R)
  (COND [(LESSP (CAR Z-R) (CADR Z-R)) (REVERSE Z-R)] [T Z-R]))
 EXPR)

(DEFPROP ZRANGES
 (LAMBDA (Z-R)
  (COND [(NULL Z-R) ZRANGE]
	[(NOT (ATOM (SETQ Z-R (ZINST (CAR Z-R))))) Z-R]
	[T (LIST ZHIGH Z-R)]))
 EXPR)

(DEFPROP READNET
 (LAMBDA NIL
  (PROG (Z-E Z-L Z-L1)
   LOOP (COND [(NULL (SETQ Z-E (READ))) (RETURN 'Net-Loaded)]
	      [(SETQ Z-L1 (ZPROC? Z-E)) (SETQ Z-L Z-L1) (GO LOOP)])
	(COND [Z-L (SETQ Z-E (EVAL Z-E))
		   (OR [MEMB Z-E Z-L] [ZPLACD Z-L (CONS Z-E (CDR Z-L))])]
	      [T (ZADD (CAR Z-E) (CDR Z-E))])
	(GO LOOP)))
 EXPR)

(DEFP *REMOVE REMOVE SUBR)

(DEFPROP REMOVE
 (LAMBDA (Z-DAT)
  (PROG (Z-L Z-P)
	(COND [(NOT (SETQ Z-L (ZPROC? (CAR Z-DAT))))
	       (RETURN (ZREMOVE (ZINST (CAR Z-DAT))))]
	      [(NOT (ATOM (SETQ Z-P (CADR Z-DAT)))) (SETQ Z-P (EVAL Z-P))])
	(COND [(SETQ Z-L (ZMEMB Z-P Z-L))
	       (ZPLACD Z-L (CDDR Z-L))
	       (AND ZTRACEDFNS [ZBREAK1 '(REMOVE NET) NIL Z-P 0.])
	       (RETURN Z-P)]
	      [T (RETURN FAIL)])))
 FEXPR)

(DEFPROP ZREMOVE
 (LAMBDA (Z-DAT)
  (PROG (Z-L)
	(COND [(SETQ Z-L (ZMEMBC Z-DAT ZNET))
	       (SETQ Z-DAT (CADR Z-L))
	       (ZPLACD Z-L (CDDR Z-L))]
	      [T (RETURN FAIL)])
	(MAPC (FUNCTION
	       (LAMBDA (Z-A)
		(SETQ Z-L (GET Z-A ZINDEX))
		(ZPLACD (CAR Z-L) (SUB1 (CDAR Z-L)))
		(ZPLACD (SETQ Z-L (ZMEMB Z-DAT Z-L)) (CDDR Z-L))))
	      (ZATOMS (CAR Z-DAT)))
	(AND ZTRACEDFNS [ZBREAK1 '(REMOVE NET) NIL Z-DAT 0.])
	(RETURN (ZCAR Z-DAT))))
 EXPR)

(DEFPROP ZREMPROP
 (LAMBDA (AT PROP) (AND [SETQ AT (GET AT PROP)] [ZPLACD AT NIL] T))
 EXPR)

(DEFPROP ZRESET
 (LAMBDA (Z-L)
  (MAPC (FUNCTION SET) Z-L (CAR ZRESETV))
  (COND [(NULL (SETQ ZRESETV (CDR ZRESETV))) Z*NIL*]
	[T (SETQ ZVALUE (CONS (CAR ZRESETV) '(NIL NIL NIL)))
	   (SETQ ZRESETV (CDR ZRESETV))]))
 EXPR)

(DEFPROP RESTORE
 (LAMBDA Z-L (ZRESTORE (COND [(ZEROP Z-L) ZSAVEP] [T (ARG 1.)])))
 EXPR)

(DEFPROP ZRESTORE
 (LAMBDA (Z-L)
  (PROG NIL
	(COND [(NOT (TAILP Z-L ZSAVE)) (ZERROR '"BACKTRACK ERROR - RESTORE")])
   LOOP (COND [(EQ Z-L ZSAVE) (RETURN T)])
	(RPLACD (CAAR ZSAVE) (CDAR ZSAVE))
	(SETQ ZSAVE (CDR ZSAVE))
	(GO LOOP)))
 EXPR)

(DEFPROP SAVE (LAMBDA NIL ZSAVE) EXPR)

(DEFV SAVE T)

(DEFPROP ZSET
 (LAMBDA (Z-V Z-E)
  (PROG (Z-VAL)
	(COND [(NULL Z-V) (ZERROR '"CAN'T CHANGE VALUE OF NIL")]
	      [(ATOM Z-V)
	       (OR [SETQ Z-VAL (GET Z-V 'VALUE)]
		   [PUT Z-V (SETQ Z-VAL (CONS Z-V (UNBOUND))) 'VALUE])
	       (ZPLACD Z-VAL Z-E)]
	      [T (ZBIND (CADR Z-V) Z-E)])
	(RETURN Z-E)))
 EXPR)

(DEFPROP ZSETV
 (LAMBDA (Z-L)
  (COND [(NULL Z-L) (SETQ ZVALUE Z*NIL*)]
	[(PROG1 (CDR Z-L) (SETQ ZVALUE (ZINST (CAR Z-L))))
	 (SETQ ZVALUE (ZCONS ZVALUE (EVAL (CADR Z-L))))]))
 EXPR)

(DEFPROP STATE
 (LAMBDA (Z-FL)
  (PROG (Z-F)
	(SETQ Z-F (OUTCH))
	(AND Z-F [MSG T "(READNET)" T])
	(COND [(AND [CDR ZNET] [OR [NULL Z-FL] [EQ (CAR Z-FL) 'NET]])
	       (AND [NULL Z-F] [MSG T "==NET==" T])
	       (MAPC (FUNCTION PRINT) (CDR ZNET))
	       (TERPRI)])
	(COND [(OR [NULL Z-FL] [EQ (CAR Z-FL) 'PROCS])
	       (COND [(CDR DPROCS)
		      (PRINT (COND [Z-F 'DEDUCE:] [T '==DEDUCE-PROCS==]))
		      (TERPRI)
		      (APPLY# 'PP (CDR DPROCS))])
	       (COND [(CDR APROCS)
		      (PRINT (COND [Z-F 'ASSERT:] [T '==ASSERT-PROCS==]))
		      (TERPRI)
		      (APPLY# 'PP (CDR APROCS))])
	       (COND [(CDR EPROCS)
		      (PRINT (COND [Z-F 'ERASE:] [T '==ERASE-PROCS==]))
		      (TERPRI)
		      (APPLY# 'PP (CDR EPROCS))])])
	(AND Z-F [MSG T NIL T])))
 FEXPR)

(DEFPROP SUCCEED (LAMBDA (Z-L) (ZSETV Z-L) (THROW NIL SUCCEED)) FEXPR)

(DEFPROP SUCCEEDP (LAMBDA (X) (NEQ X FAIL)) EXPR)

(DEFPROP SUCCEED!
 (LAMBDA (Z-L) (ZSETV Z-L) (SETQ ZSAVE ZSAVEP) (THROW NIL SUCCEED))
 FEXPR)

(DEFPROP SUCCEED?
 (LAMBDA (Z-L)
  (ZSETV Z-L)
  (COND [ZSUCCEED? (SETQ ZRESETV NIL) (THROW NIL SUCCEED?)]
	[T (THROW NIL SUCCEED)]))
 FEXPR)

(DEFPROP THRESH:
 (LAMBDA (Z-NM) (ZPROCN (CAR Z-NM) 'THRESH: (FUNCTION CDDDR) (CDR Z-NM)))
 FEXPR)

(DEFPROP TRY
 (LAMBDA (Z-L)
  (SETQ ZRESETV NIL)
  (ZDEDUCE (ZINSTPD (CADR Z-L))
	   (CONS NIL (ZINST (CAR Z-L)))
	   (ZRANGER (ZRANGES (CDDR Z-L)))))
 FEXPR)

(DEFPROP VAL
 (LAMBDA Z-E (ZVALV (COND [(ZEROP Z-E) ZVALD] [T (ARG 1.)])))
 EXPR)

(DEFPROP ZVAL
 (LAMBDA Z-E (ZVALZ (COND [(ZEROP Z-E) ZVALD] [T (ARG 1.)])))
 EXPR)

(DEFPROP ZVAL:
 (LAMBDA (Z-NM) (ZPROCN (CAR Z-NM) 'ZVAL: (FUNCTION CDDDR) (CDR Z-NM)))
 FEXPR)

(DEFPROP ZVALV
 (LAMBDA (Z-E)
  (COND [(ATOM Z-E) Z-E] [(NUMBERP (CDR Z-E)) (CAR Z-E)] [T Z-E]))
 EXPR)

(DEFPROP ZVALZ
 (LAMBDA (Z-E)
  (COND [(EQ Z-E FAIL) ZLOW]
	[(ATOM Z-E) ZHIGH]
	[(NUMBERP (SETQ Z-E (CDR Z-E))) Z-E]
	[T ZHIGH]))
 EXPR)

(DEFV Z*NIL* Z*NIL*)

(DEFV DONE DONE)

{;; Pattern Functions:⎇

(DEFPROP *!
 (LAMBDA (Z-A)
  (SETQ Z-A (CAR Z-A))
  (COND [(NOT (ATOM Z-A)) (ZINST Z-A)] [T (ZLOOK! Z-A)]))
 FEXPR)

(DEFPROP *! T ZPATF)

(DEFPROP *! Z*! ZPATEI)

(DEFPROP Z*!
 (LAMBDA (Z-A)
  (COND [(NOT (ATOM Z-A)) Z-A]
	[(NULL ZINSTF) (ZLOOK! Z-A)]
	[(ZLOOK? Z-A) ZLOOKV]
	[T (LIST '*? Z-A)]))
 EXPR)

(DEFPROP *& (LAMBDA (Z-A) Z-A) EXPR)

(DEFPROP *& T ZPATF)

(DEFPROP *& Z*& ZPATEI)

(DEFPROP Z*& (LAMBDA (Z-A) (EVAL Z-A)) EXPR)

(DEFPROP QUOTE T ZPATF)

(DEFPROP *!! T ZPATF)

(DEFPROP *!! Z*!! ZPATES)

(DEFPROP Z*!!
 (LAMBDA (Z-A)
  (COND [(NOT (ATOM Z-A)) Z-A]
	[(NULL ZINSTF) (CONSP (ZLOOK! Z-A))]
	[(ZLOOK? Z-A) (CONSP ZLOOKV)]
	[T (LIST (LIST '*?? Z-A))]))
 EXPR)

(DEFPROP *&& T ZPATF)

(DEFPROP *&& Z*&& ZPATES)

(DEFPROP Z*&& (LAMBDA (Z-A) (CONSP (EVAL Z-A))) EXPR)

(DEFPROP *? T ZPATF)

(DEFPROP *? Z*? ZPATMI)

(DEFPROP Z*?
 (LAMBDA (Z-ARGS Z-DAT) (COND [Z-ARGS (ZBIND (CAR Z-ARGS) Z-DAT)]))
 EXPR)

(DEFPROP *AND T ZPATF)

(DEFPROP *AND Z*AND ZPATMI)

(DEFPROP Z*AND
 (LAMBDA (Z-ARGS Z-DAT)
  (PROG NIL
   LOOP (COND [Z-ARGS (ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT)
		      (SETQ Z-ARGS (CDR Z-ARGS))
		      (GO LOOP)])))
 EXPR)

(DEFPROP *ANY T ZPATF)

(DEFPROP *ANY Z*ANY ZPATMI)

(DEFPROP Z*ANY
 (LAMBDA (Z-ARGS Z-DAT)
  (COND [(MEMBER Z-DAT (ZINST (CADR Z-ARGS)))
	 (ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT)]
	[T (THROW NIL MATCH)]))
 EXPR)

(DEFPROP *CON T ZPATF)

(DEFPROP *CON Z*CON ZPATMI)

(DEFPROP Z*CON
 (LAMBDA (Z-ARGS Z-DAT)
  (SETQ ZTEMPV (ZINST (CADR Z-ARGS)))
  (SETQ ZTEMP2 Z-DAT)
  (COND [(CATCH [Z*CON1 ZTEMP2]) (ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT)]
	[T (THROW NIL MATCH)]))
 EXPR)

(DEFPROP Z*CON1
 (LAMBDA (Z-DAT)
  (COND [(EQUAL ZTEMPV Z-DAT) (THROW T)]
	[(NOT (ATOM Z-DAT)) (MAPC (FUNCTION Z*CON1) Z-DAT)]))
 EXPR)

(DEFPROP *NOT T ZPATF)

(DEFPROP *NOT Z*NOT ZPATMI)

(DEFPROP Z*NOT
 (LAMBDA (Z-ARGS Z-DAT)
  (COND [(ZMATCH (ZINSTP (CADR Z-ARGS)) Z-DAT) (THROW NIL MATCH)]
	[T (ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT)]))
 EXPR)

(DEFPROP *OR T ZPATF)

(DEFPROP *OR Z*OR ZPATMI)

(DEFPROP Z*OR
 (LAMBDA (Z-ARGS Z-DAT)
  (PROG NIL
   LOOP (COND [(NULL Z-ARGS) (THROW NIL MATCH)]
	      [(NOT (ZMATCH (ZINSTP (CAR Z-ARGS)) Z-DAT))
	       (SETQ Z-ARGS (CDR Z-ARGS))
	       (GO LOOP)])))
 EXPR)

(DEFPROP *R T ZPATF)

(DEFPROP *R Z*R ZPATMI)

(DEFPROP Z*R
 (LAMBDA (Z-ARGS Z-DAT)
  (ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-DAT)
  (COND [(AND [CDR Z-ARGS]
	      [OR [NULL (SETQ Z-ARGS (EVAL (CADR Z-ARGS)))] [EQ Z-ARGS FAIL]])
	 (THROW NIL MATCH)]))
 EXPR)

(DEFPROP *LEN T ZPATF)

(DEFPROP *LEN Z*LEN ZPATMS)

(DEFPROP Z*LEN
 (LAMBDA (Z-ARGS Z-PAT Z-DAT)
  (PROG (Z-N Z-L)
	(SETQ Z-N (EVAL (CADR Z-ARGS)))
	(COND [(ZEROP Z-N) (GO DONE)])
   LOOP (COND [(OR [NULL Z-DAT] [NOT (ZINST? (CAR Z-DAT))]) (THROW NIL MATCH)])
	(SETQ Z-L (NCONC Z-L (LIST (CAR Z-DAT))))
	(SETQ Z-DAT (CDR Z-DAT))
	(COND [(NOT (ZEROP (SETQ Z-N (SUB1 Z-N)))) (GO LOOP)])
	(ZMATCH1 (ZINSTP (CAR Z-ARGS)) Z-L)
   DONE (ZMATCH1 Z-PAT Z-DAT)))
 EXPR)

(DEFPROP *OPT T ZPATF)

(DEFPROP *OPT Z*OPT ZPATMS)

(DEFPROP Z*OPT
 (LAMBDA (Z-ARGS Z-PAT Z-DAT)
  (COND [(AND Z-DAT 
	      [ZINST? (CAR Z-DAT)]
	      [ZMATCH (ZINSTP (CAR Z-ARGS)) (CAR Z-DAT)])
	 (SETQ Z-DAT (CDR Z-DAT))]
	[(CDR Z-ARGS) (EVAL (CADR Z-ARGS))])
  (ZMATCH1 Z-PAT Z-DAT))
 EXPR)

(DEFPROP *REP T ZPATF)

(DEFPROP *REP Z*REP ZPATMS)

(DEFPROP Z*REP
 (LAMBDA (Z-ARGS Z-PAT Z-DAT)
  (PROG (Z-P Z-N)
	(SETQ Z-P (ZINSTP (CAR Z-ARGS)))
	(COND [(CDR Z-ARGS) (SETQ Z-N (EVAL (CADR Z-ARGS))) (GO LOOP)])
     LP (COND [(AND Z-DAT [ZINST? (CAR Z-DAT)] [ZMATCH Z-P (CAR Z-DAT)])
	       (SETQ Z-DAT (CDR Z-DAT))
	       (GO LP)]
	      [T (GO DONE)])
   LOOP (COND [(ZEROP Z-N) (GO DONE)]
	      [(OR [NULL Z-DAT] [NOT (ZINST? (CAR Z-DAT))]) (THROW NIL MATCH)])
	(ZMATCH1 Z-P (CAR Z-DAT))
	(SETQ Z-DAT (CDR Z-DAT))
	(SETQ Z-N (SUB1 Z-N))
	(GO LOOP)
   DONE (ZMATCH1 Z-PAT Z-DAT)))
 EXPR)

(DEFPROP *?? T ZPATF)

(DEFPROP *?? Z*?? ZPATMS)

(DEFPROP Z*??
 (LAMBDA (Z-ARGS Z-PAT Z-DAT) (Z*??1 Z-ARGS Z-PAT Z-DAT NIL))
 EXPR)

(DEFPROP *??: T ZPATF)

(DEFPROP *??: Z*??: ZPATMS)

(DEFPROP Z*??:
 (LAMBDA (Z-ARGS Z-PAT Z-DAT) (Z*??1 Z-ARGS Z-PAT Z-DAT T))
 EXPR)

(DEFPROP Z*??1
 (LAMBDA (Z-ARGS Z-PAT Z-DAT Z-:)
  (PROG (Z-N Z-L)
	(COND [Z-ARGS (SETQ Z-N (CAR Z-ARGS))])
	(COND [(NULL Z-PAT)
	       (COND [(NOT (ZINST? Z-DAT)) (THROW NIL MATCH)]
		     [Z-: (RETURN (ZBIND Z-N (LENGTH Z-DAT)))]
		     [Z-N (RETURN (ZBIND Z-N Z-DAT))]
		     [T (RETURN T)])])
	(COND [Z-: (SETQ Z-L 0.)])
   LOOP (COND [Z-N (ZBIND Z-N Z-L)])
	(COND [(ZMATCH Z-PAT Z-DAT) (RETURN T)]
	      [(OR [NULL Z-DAT] [NOT (ZINST? (CAR Z-DAT))]) (THROW NIL MATCH)]
	      [Z-: (SETQ Z-L (ADD1 Z-L))]
	      [Z-N (SETQ Z-L (NCONC Z-L (LIST (CAR Z-DAT))))])
	(SETQ Z-DAT (CDR Z-DAT))
	(GO LOOP)))
 EXPR)

{;; Readmacro stuff:⎇

(DEFPROP ZREAD!
 (LAMBDA NIL
  (COND [(EQ (PEEKC) 33.) (TYI) (LIST '*!! (READ))]
	[T (LIST '*! (READ))]))
 EXPR)

(DEFPROP ZREAD&
 (LAMBDA NIL
  (COND [(EQ (PEEKC) 38.) (TYI) (LIST '*&& (READ))]
	[T (LIST '*& (READ))]))
 EXPR)

(DEFPROP ZREAD?
 (LAMBDA NIL
  (PROG (Z-C)
	(SETQ Z-C (PEEKC))
	(RETURN (COND [(EQ Z-C 64.) (TYI) (LIST '*?Q (READ))]
		      [(DELIM Z-C) '(*?)]
		      [(NEQ Z-C 63.) (LIST '*? (READ))]
		      [(DELIM (SETQ Z-C (PROGN (TYI) (PEEKC)))) '(*??)]
		      [(EQ Z-C 58.) (TYI) (LIST '*??: (READ))]
		      [T (LIST '*?? (READ))]))))
 EXPR)

(SETQ MODCHR! (MODCHR 33. NIL))

(SETQ MODCHR& (MODCHR 38. NIL))

(SETQ MODCHR? (MODCHR 63. NIL))

(DEFPROP FUZZYMACS
 (LAMBDA (FLG)
  (COND [(EQ FLG FUZZYMACS) FUZZYMACS]
	[T (SETQ MODCHR! (MODCHR 33. MODCHR!))
	   (SETQ MODCHR& (MODCHR 38. MODCHR&))
	   (SETQ MODCHR? (MODCHR 63. MODCHR?))
	   (NOT (SETQ FUZZYMACS FLG))]))
 EXPR)

(DEFV FUZZYMACS NIL)

{;; Debug and Utility Functions:⎇

(DEFPROP ZTRACE
 (LAMBDA (Z-L)
  (MAPCAR (FUNCTION
	   (LAMBDA (Z-A)
	    (COND [(ATOM Z-A) (SETQ Z-A (CONS Z-A '(T NIL)))]
		  [(ATOM (CDR Z-A)) (NCONC Z-A '(T NIL))]
		  [(ATOM (CDDR Z-A)) (NCONC Z-A '(NIL))])
	    (AND [NOT (MEMB (CAR Z-A) '(ADD REMOVE FETCH NET PROCS))]
		 [NOT (GET (CAR Z-A) 'PROC)]
		 [ZERROR (CAR Z-A) '" IS NOT A PROC"])
	    (AND [SETQ Z-L (ASSOC (CAR Z-A) ZTRACEDFNS)]
		 [SETQ ZTRACEDFNS (DREMOVE Z-L ZTRACEDFNS)])
	    (SETQ ZTRACEDFNS (CONS Z-A ZTRACEDFNS))
	    (CAR Z-A)))
	  Z-L))
 FEXPR)

(DEFPROP ZUNTRACE
 (LAMBDA (Z-L)
  (COND [(NULL Z-L) (PROG1 (MAPCAR 'CAR ZTRACEDFNS) (SETQ ZTRACEDFNS NIL))]
	[T (MAPCAR (FUNCTION
		    (LAMBDA (Z-A)
		     (COND [(SETQ Z-L (ASSOC Z-A ZTRACEDFNS))
			    (SETQ ZTRACEDFNS (DREMOVE Z-L ZTRACEDFNS))
			    Z-A]
			   [T (CONS Z-A '(IS NOT ZTRACED))])))
		   Z-L)]))
 FEXPR)

(DEFPROP ZBREAK1
 (LAMBDA (Z-L Z-MESS Z-DAT Z-N)
  (PROG (Z-L1 Z-V Z-VALUE Z-RESETV)
	(OR [SETQ Z-L1
		  (OR [ASSOC (CAR Z-L) ZTRACEDFNS]
		      [ASSOC (CADR Z-L) ZTRACEDFNS])]
	    [RETURN NIL])
	(SETQ *ARG Z-DAT)
	(SETQ Z-VALUE ZVALUE)
	(SETQ Z-RESETV ZRESETV)
	(COND [(SETQ Z-V (EVAL (CADR Z-L1)))
	       (AND [MINUSP Z-N] [SETQ #%INDENT (*PLUS #%INDENT Z-N)])
	       (BKPOS #%INDENT)
	       (AND Z-MESS [PRINC Z-MESS])
	       (PRINC (CAR Z-L))
	       (PRINC ':/ )
	       (SPRINT (ZCAR Z-DAT) (CHRPOS))
	       (AND [*GREAT Z-N 0.] [SETQ #%INDENT (*PLUS #%INDENT Z-N)])])
	(COND [(OR [AND [EQ (CADDR Z-L1) 'DITTO] Z-V] [EVAL (CADDR Z-L1)])
	       (BREAK1 NIL T (CAR Z-L) NIL NIL)])
	(SETQ ZVALUE Z-VALUE)
	(SETQ ZRESETV Z-RESETV)))
 EXPR)

(DEFP %ZEDITF EDITF FSUBR)

(DEFPROP EDITF
 (LAMBDA (X)
  (PROG (Y)
	(COND [(NULL X)
	       (TERPRI)
	       (PRINC '"= ")
	       (PRIN1 LASTWORD)
	       (TERPRI)
	       (SETQ X (NCONS LASTWORD))])
	(COND [(NOT (SETQ Y (GET (CAR X) 'PROC))) (RETURN (APPLY# '%ZEDITF X))]
	      [T (EDITE Y (CDR X) (CAR X))
		 (SETQ LASTWORD (CAR X))
		 (RETURN (EVAL Y))])))
 FEXPR)

(RPLACA (MEMB 'FEXPR PRETTYPROPS) '(FEXPR . ZPP-FEXPR))

(DEFPROP ZPP-FEXPR
 (LAMBDA (%A %D %P)
  (COND [(SETQ %P (GET %A 'PROC))
	 (AND [OUTCH]
	      [MEMB (CADDR %P) ZGENPROCS]
	      [SETQ %P (CONS 'PROC (CDDDR %P))])
	 (SPRINT %P 1.)]
	[T (SPRINT (LIST 'DEFPROP %A %D 'FEXPR) 1.)]))
 EXPR)

(DEFPROP ZPP-PROC
 (LAMBDA (L)
  (PROG (N L1)
	(SETQ N 1.)
	(SETQ L1 (CDR L))
   LOOP (COND [(MEMB (CAR L1) '(NAME: GLOBAL: DEMON: ACCUM: THRESH: ZVAL:))
	       (SETQ N (*PLUS N 2.))
	       (SETQ L1 (CDDR L1))
	       (GO LOOP)])
	(PP-FORMAT L N 'LABELS)))
 EXPR)

(DEFPROP ZPP-FOR
 (LAMBDA (L)
  (PROG (C N)
	(SETQ C (CADR L))
	(COND [(MEMB C '(DEDUCE: D: GOAL: G: FETCH: F:))
	       (SETQ N (COND [(EQ (CADDR L) 'ZVAL:) 4.] [2.]))]
	      [(OR [EQ C 'TRY:] [EQ C 'T:])
	       (SETQ N (COND [(EQ (CAR (CDDDDR L)) 'ZVAL:) 5.] [3.]))]
	      [T (SETQ N 2.)])
	(PP-FORMAT L N NIL)))
 EXPR)

(DEFPROP ZPP-?
 (LAMBDA (L)
  (PROG (C)
	(SETQ C (COND [(EQ (CAR L) '*?) '"?"] [T '"??"]))
	(COND [(NULL (CDR L)) (PRINC C)]
	      [(OR [ATOM (CDR L)] [CDDR L]) (RETURN 'SPRINT)]
	      [T (PRINC C) (SPRINT (CADR L) (CHRPOS))])))
 EXPR)

{;; Initialization:⎇

(SETQ %%ENDGP (LAST PRETTYPROPS))

(NCONC PRETTYPROPS '(ZPATF ZPATEI ZPATES ZPATMI ZPATMS))

(PROGN
(DEFPROP ZINIT
 (LAMBDA NIL
  (SETQ ZHIGH 1.)
  (SETQ ZLOW 0.)
  (SETQ ZRANGE '(1. 0.))
  (SETQ ZGENPROCN 0.)
  (SETQ ZGENPROCS NIL)
  (SETQ ZTRACEDFNS NIL)
  (SETQ ZINDEX 'INITIAL-CONTEXT)
  (SETQ DEFDEMON '*DEMON)
  (SETQ DEFZVAL ZLOW)
  (SETQ DEFACCUM ZHIGH)
  (SETQ ZNET (LIST NIL))
  (SETQ DPROCS (LIST NIL))
  (SETQ APROCS (LIST NIL))
  (SETQ EPROCS (LIST NIL))
  (SETQ ZSAVE (SETQ ZSAVEP '(TOP-LEVEL)))
  (SETQ ZGLOBEV NIL)
  (SETQ ZALIST NIL)
  (SETQ ZSUCCEED? NIL)
  (SETQ ZDEMON NIL)
  (SETQ ZRESETV NIL)
  (SETQ ZVALUE NIL)
  (DRM ! ZREAD!)
  (DRM & ZREAD&)
  (DRM ? ZREAD?)
  (SETQ FUZZYMACS T)
  (MAPC (FUNCTION (LAMBDA (X Y) (PUTPROP X Y 'PRINTMACRO)))
	'(*! *!! *& *&& *?Q *??: *? *?? PROC FOR IF IFALL IFANY ZAND ZOR)
	'("!" "!!" "&" "&&" "?@" "??:" ZPP-? ZPP-? ZPP-PROC ZPP-FOR PP-LABELS
	      PP-LABELS PP-LABELS BRACKETS BRACKETS))
  (DEFPROP ZCALL (NIL NIL NIL NIL) ERXACTION)
  (DEFLIST (ADD ASSERT DEDUCE ERASE FETCH FOR GOAL REMOVE TRY)
	   (NIL T T T)
	   ERXACTION)
  T)
 EXPR)

(DEFPROP ZUNINIT
 (LAMBDA NIL
  (FUZZYMACS NIL)
  (REMLIST '(*! *!! *& *&& *?Q *??: *? *?? PROC FOR IF IFALL IFANY ZAND ZOR)
	   'PRINTMACRO)
  (REMLIST '(ADD ASSERT DEDUCE ERASE FETCH FOR GOAL REMOVE TRY) 'ERXACTION)
  T)
 EXPR)

(DEFPROP ZCLEANUP
 (LAMBDA NIL
  (RPLACD %%ENDGP NIL)
  (REMOB %%ENDGP FUZZYFNS ZINIT ZUNINIT ZCLEANUP)
  (INC NIL T)
  (OUTC NIL T)
  (FLUSH)
  (GC)
  (INITFL (FUZZY . INI))
  (INITFN (FUNCTION
	   (LAMBDA NIL
	    (MSG T "FUZZY - 3/10/78" T)
	    (ERRSET (TYPE LSP: (FUZZY . MSG)) NIL)
	    (EXCISE)
	    (SETQ %%TIME (TIME))
	    (SETQ %%DTIME (DTIME))
	    (SETQ %%GCTIME (GCTIME))
	    (SETQ %%SPEAK (SPEAK))
	    (INITFN NIL))))
  (SYSCLR))
 EXPR)
)

(NOCOMPILE
(DEFV FUZZYFNS ((DECLARE (*LSUBR ZERROR FAIL FINALIZE NETDIF RESTORE VAL ZVAL) 
		(SPECIAL ZALIST ZSUCCEED? ZDEMON ZACCUM ZTHRSH ZSAVEP ZSAVED 
		ZSAVEF ZSAVF1 ZPAT ZDATS ZLIST ZLIST1 ZPROCS ZRNG ZRSETV ZVLD) 
		(SPECIAL Z*NIL* FAIL DONE ZHIGH ZLOW ZRANGE ZNET DPROCS 
		APROCS EPROCS ZSAVE ZGLOBEV ZTEMPV ZFETCHV ZRESETV ZINSTF 
		ZINSTPF ZINST?F ZLOOKV %%ENDGP FUZZYMACS ZVALUE ZTEMP2 
		MODCHR! MODCHR& MODCHR? ZALIST1 ZVALD ZDEDUCEV ZGENPROCN 
		ZGENPROCS LASTWORD ZTRACEDFNS *ARG #%INDENT FUZZYMESS) 
		(SPECIAL %%TIME %%GCTIME %%SPEAK ALLFNS BASE *NOPOINT ZINDEX 
		ZNAME DEFDEMON DEFZVAL DEFACCUM)) ACCUM: ADD ZADD ZADDPROP 
		ZAND ZANDOR ASSERT ZATOMS ZATOM1 BACK BIND BIND! ZBIND BOUND 
		ZCALL ZCALLP ZCALLD ZCALLEM ZCAR ZCONS CONTEXT DEDUCE ZDEDUCE 
		DEMON: DO? DO! ZERROR ERASE (DEFP *EXIT EXIT SUBR) EXIT FAIL 
		FAILP FETCH ZFETCH FINALIZE FLUSH FOR ZFOR ZFORFD ZGENPROC 
		ZGET ZGETAS GLOBAL ZGLOBE GOAL GOTO IFALL (DEFP IF IFALL 
		(FEXPR FSUBR)) IFANY ZINST ZINSTP ZINSTD ZINSTR ZINSTPD 
		ZINST1 ZINST? ZINSTP? ZINST?1 ZLOOK ZLOOK! ZLOOK? MATCH 
		ZMATCH ZMATCH1 ZMEMB ZMEMBC ZMEMBN NETADD NETDIF ZNETDIF NEXT 
		NOHASH ZNOT ZOR ZPLACD POP PROC *DEMON ZPROCN ZPROC ZPROC? 
		PUSH PUSH? ZPUT RANGE ZRANGEP ZRANGER ZRANGES READNET 
		(DEFP *REMOVE REMOVE SUBR) REMOVE ZREMOVE ZREMPROP ZRESET 
		RESTORE ZRESTORE SAVE ZSET ZSETV STATE SUCCEED SUCCEEDP 
		SUCCEED! SUCCEED? THRESH: TRY VAL ZVAL ZVAL: ZVALV ZVALZ 
		Z*NIL* DONE (*PG*) (*** Pattern Functions:) *! Z*! *& Z*& 
		(DEFPROP QUOTE T ZPATF) *!! Z*!! *&& Z*&& *? Z*? *AND Z*AND 
		*ANY Z*ANY *CON Z*CON Z*CON1 *NOT Z*NOT *OR Z*OR *R Z*R *LEN 
		Z*LEN *OPT Z*OPT *REP Z*REP *?? Z*?? *??: Z*??: Z*??1 
		(*PG*) (*** Readmacro stuff:) ZREAD! ZREAD& ZREAD? 
		(SETQ MODCHR! (MODCHR 33. NIL)) (SETQ MODCHR& (MODCHR 38. NIL)) 
		(SETQ MODCHR? (MODCHR 63. NIL)) FUZZYMACS (*PG*) (*** Debug 
		and Utility Functions:) ZTRACE ZUNTRACE ZBREAK1 (DEFP %ZEDITF 
		EDITF FSUBR) EDITF (RPLACA (MEMB (QUOTE FEXPR) PRETTYPROPS) 
		(QUOTE (FEXPR . ZPP-FEXPR))) ZPP-FEXPR ZPP-PROC ZPP-FOR ZPP-? 
		(*PG*) (*** Initialization:) (SETQ %%ENDGP (LAST PRETTYPROPS)) 
		(NCONC PRETTYPROPS (QUOTE (ZPATF ZPATEI ZPATES ZPATMI ZPATMS))) 
		(MBD: PROGN ZINIT ZUNINIT ZCLEANUP)))
)